home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgramD2.iso / Visual Database / Visual BASIC 5.0 (Ent. Edition) / Vb5ent Extractor.EXE / VB / SAMPLES / ENTRPRIS / POOLMGR / PMGR_SVR.CLS < prev    next >
Encoding:
Text File  |  1996-11-23  |  3.4 KB  |  110 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "PoolMngrClass"
  6. Attribute VB_Creatable = True
  7. Attribute VB_Exposed = True
  8. Option Explicit
  9.  
  10. Public Function objGetProjInstance(rstrProgID As String, rnProjID As Integer) As Object
  11. 'Note: This routine assumes PoolMngrClass has been created with MultiUse and is not reentrant!
  12. 'Return an OLE automation object reference to the requested project
  13. 'Return rnProjID < 0 if no Instances are available or error
  14. Dim nPrjNode As Integer
  15. Dim nSvrNode As Integer
  16. Dim bFoundFree As Integer
  17. Dim nFirstFree As Integer
  18. On Error GoTo gciError
  19.  
  20. rnProjID = -1
  21. nPrjNode = gnFirstPrjNode
  22.  
  23. While nPrjNode <> gnNIL And rnProjID < 0
  24.   If gaPrjInfo(nPrjNode).strProgID = rstrProgID Then
  25.     If gaPrjInfo(nPrjNode).intCurUseCount >= gaPrjInfo(nPrjNode).intMaxUseCount Then Exit Function
  26.     nSvrNode = gaPrjInfo(nPrjNode).nFirstSvrNode
  27.     bFoundFree = False
  28.     While nSvrNode <> gnNIL And Not bFoundFree
  29.       If gaSvrInst(nSvrNode).bInUse Then
  30.         nSvrNode = gaSvrInst(nSvrNode).Next
  31.       Else
  32.         bFoundFree = True
  33.       End If
  34.     Wend
  35.       
  36.     If Not bFoundFree Then
  37.       nSvrNode = GetNewServerNode(nPrjNode)
  38.       If nSvrNode = gnNIL Then Exit Function
  39.       Set gaSvrInst(nSvrNode).ObjHandle = CreateObject(rstrProgID)
  40.     End If
  41.       
  42.     Set objGetProjInstance = gaSvrInst(nSvrNode).ObjHandle
  43.     gaSvrInst(nSvrNode).DeallocTime = "12/31/9999"
  44.     gaSvrInst(nSvrNode).bInUse = True
  45.     gaPrjInfo(nPrjNode).intCurUseCount = gaPrjInfo(nPrjNode).intCurUseCount + 1
  46.     rnProjID = nSvrNode
  47.     
  48.     If gaPrjInfo(nPrjNode).bLookAheadCreate And _
  49.           gaPrjInfo(nPrjNode).intCurUseCount < gaPrjInfo(nPrjNode).intMaxUseCount Then
  50.       'Save nPrjNode and set timer to wake up and do look ahead create
  51.     End If
  52.   Else
  53.     nPrjNode = gaPrjInfo(nPrjNode).Next
  54.   End If
  55. Wend
  56.  
  57.   If rnProjID < 0 Then
  58. '   objGetClassInstance = Nothing << causes error!  what can you return??
  59.   End If
  60. GoTo gciExit
  61.  
  62. gciError:
  63. '  objGetClassInstance = Nothing << causes error!  what can you return??
  64.   Resume gciExit
  65.   
  66. gciExit:
  67. End Function
  68. Public Function ReturnProjInstance(ByVal rstrProgID As String, rnSvrNode As Integer) As Integer
  69. 'Note: This routine assumes MultiUse and is not reentrant!
  70. 'Return False if error
  71. Dim nPrjNode As Integer
  72. Dim bDone As Integer
  73. On Error GoTo rpiError
  74.  
  75. ReturnProjInstance = False
  76. If rnSvrNode < 0 Then Exit Function
  77. If Not gaSvrInst(rnSvrNode).bInUse Then Exit Function
  78. nPrjNode = gnFirstPrjNode
  79.  
  80. While nPrjNode <> gnNIL And Not bDone
  81.   If gaPrjInfo(nPrjNode).strProgID = rstrProgID Then
  82.     gaPrjInfo(nPrjNode).intCurUseCount = gaPrjInfo(nPrjNode).intCurUseCount - 1
  83.     If gaPrjInfo(nPrjNode).intCurUseCount >= gaPrjInfo(nPrjNode).intMinUseCount Then
  84.       If gaPrjInfo(nPrjNode).intCloseDelay > 0 Then
  85.         'Save nPrjNode and set timer to wake up and destroy node later
  86.         gaSvrInst(rnSvrNode).DeallocTime = Now
  87.       Else
  88.         Set gaSvrInst(rnSvrNode).ObjHandle = Nothing
  89.         If gaPrjInfo(nPrjNode).nFirstSvrNode = rnSvrNode Then
  90.           gaPrjInfo(nPrjNode).nFirstSvrNode = gaSvrInst(gaPrjInfo(nPrjNode).nFirstSvrNode).Next
  91.         End If
  92.         NodeRemove gnINST_TYPE, rnSvrNode
  93.       End If
  94.       bDone = True
  95.     Else
  96.       gaSvrInst(rnSvrNode).bInUse = False
  97.     End If
  98.     ReturnProjInstance = True
  99.   End If
  100.   nPrjNode = gaPrjInfo(nPrjNode).Next
  101. Wend
  102. GoTo rpiExit
  103.  
  104. rpiError:
  105. Resume rpiExit
  106.  
  107. rpiExit:
  108. End Function
  109.  
  110.